home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / ISOTime.tcl < prev    next >
Encoding:
Text File  |  2001-02-07  |  12.1 KB  |  281 lines
  1. ## -*-Tcl-*- nowrap
  2.  # ###################################################################
  3.  #  AlphaTcl - core Tcl engine
  4.  # 
  5.  #  FILE: "ISOTime.tcl"
  6.  #                                    created: 1999-08-17 13:46:06 
  7.  #                                last update: 2/7/2001 {9:27:38 PM} 
  8.  #  Author: Frédéric Boulanger
  9.  #  E-mail: Frederic.Boulanger@supelec.fr
  10.  #    mail: Supélec - Service Informatique
  11.  #          Plateau de Moulon, 91192 Gif-sur-Yvette cedex, France
  12.  #     www: http://wwwsi.supelec.fr/fb/fb.html
  13.  #  
  14.  #  Description: 
  15.  #   This extension adds new choices for the second parameter (format)
  16.  #   of the 'mtime' command. "mtime [now] iso" returns the current time
  17.  #   in ISO format, i.e. "1999-08-17T14:55:22Z" for August 17 1999 at
  18.  #   2:55:22 pm.
  19.  #   To be a real ISO format, the final "Z" should be the local time
  20.  #   zone, but I don't know how to get it in Alpha, so I use "Z" which 
  21.  #   means "UTC" or universal time.
  22.  #   Using "relaxed" instead of "iso" yields a more readable date with
  23.  #   a space in place of the 'T' and without the final 'Z'.
  24.  #
  25.  #   The other choices are 'year', 'month', 'day', 'hour', 'minutes',
  26.  #   and 'seconds' to get the respective piece of time information.
  27.  #   
  28.  #   Note: This extension may yield incorrect results if you change the 
  29.  #   time format in the 'Date and Time' control panel while Alpha is running.
  30.  #   
  31.  #   The effective format of the localized time representation is 
  32.  #   determined by the ISOTime::parseLocalizedTime proc which is called
  33.  #   only once for the sake of efficiency.
  34.  #   
  35.  #   If this behaviour may cause problem and you don't use the ISOTime 
  36.  #   procs too often, you may remove the check for ISOTime::regdate and
  37.  #   ISOTime::matchdate at the beginning of ISOTime::brokenDate so that
  38.  #   it rebuilds the regexps at each call.
  39.  #   
  40.  #  History
  41.  # 
  42.  #  modified   by  rev reason
  43.  #  ---------- --- --- -----------
  44.  #  1999-08-17 FBO 1.0 original
  45.  #  1999-08-18 FBO 1.1 added year, month ... keywords for direct access
  46.  #  1999-08-26 FBO 1.2 made the date&time really ISO (YYYY-MM-DDTHH:MM:SSZ)
  47.  #  1999-09-02 VMD 1.3 made work with Alphatk, and fixed some Tcl8 isms
  48.  #  1999-11-04 FBO 1.4 added "relaxed" for a more readable ISO format
  49.  # ###################################################################
  50.  ##
  51. alpha::extension isoTime 1.4 {
  52.     # Time-stamps are in ISO or a shorter, more readable format.
  53.     newPref variable timeStampStyle short global "" "short iso relaxed"
  54.     lunion varPrefs(International) timeStampStyle
  55.     namespace eval ISOTime {}
  56.     if {[info command ISOTime::__mtime] == ""} {
  57.     rename mtime ISOTime::__mtime
  58.     proc mtime {when {format "short"}} {
  59.         switch -- $format {
  60.         relaxed {ISOTime::ISODateAndTimeRelaxed $when}
  61.         iso     {ISOTime::ISODateAndTime $when}
  62.         year    -
  63.         month   -
  64.         day     -
  65.         hour    -
  66.         minutes -
  67.         seconds {
  68.             ISOTime::brokenDate $when bdate
  69.             return $bdate($format)
  70.         }
  71.         default {ISOTime::__mtime $when $format}
  72.         }
  73.     }
  74.     }
  75. } maintainer {
  76.     "Frédéric Boulanger" Frederic.Boulanger@supelec.fr <http://wwwsi.supelec.fr/fb/fb.html>
  77. } uninstall {this-file} help {
  78.     This extension adds new choices for the second parameter
  79.     (format) of the 'mtime' command.  "mtime [now] iso" returns the
  80.     current time in ISO format, i.e. "1999-08-17T14:55:22Z" for
  81.     August 17 1999 at 2:55:22 pm.
  82.     
  83.     To be a real ISO format, the final "Z" should be the local time
  84.     zone, but I don't know how to get it in Alpha, so I use "Z"
  85.     which means "UTC" or universal time.  Using "relaxed" instead
  86.     of "iso" yields a more readable date with a space in place of
  87.     the 'T' and without the final 'Z'.
  88.     
  89.     The other choices are 'year', 'month', 'day', 'hour',
  90.     'minutes', and 'seconds' to get the respective piece of time
  91.     information.
  92.     
  93.     Note: This extension may yield incorrect results if you change
  94.     the time format in the 'Date and Time' control panel while
  95.     Alpha is running.
  96.     
  97.     The effective format of the localized time representation is
  98.     determined by the ISOTime::parseLocalizedTime proc which is
  99.     called only once for the sake of efficiency.
  100.     
  101.     If this behaviour may cause problem and you don't use the
  102.     ISOTime procs too often, you may remove the check for
  103.     ISOTime::regdate and ISOTime::matchdate at the beginning of
  104.     ISOTime::brokenDate so that it rebuilds the regexps at each
  105.     call.
  106. }
  107.  
  108. # Determine the format of the localized time representation and build a
  109. # regular expression to extract each piece of information from this format.
  110. # 
  111. # To get this information, I use the localized string representing
  112. # a known date: March 2 1904 at 5 am, 6 minutes and 7 seconds (5288767 
  113. # MacOS ticks). In this string, I look for '2' which is the day of month,
  114. # for '3' which is the month, for '4' which is the year, for '5' which is
  115. # the minutes and for '7' which is the seconds.
  116. # 
  117. # Once I got the indices of each piece of information in the string, I build
  118. # a list of 'XX YY info' items, where XX is the starting index, YY is the 
  119. # ending index for the 'info' piece of information (day, month, year...).
  120. # 
  121. # I sort this list so that I know in which order the time information is
  122. # given on the current localized version of MacOS.
  123. # 
  124. # Then, I use this list to build a regular expression that matches the 
  125. # localized representation of time, and a matching expression which will
  126. # set the items of the 'datevar' array to the corresponding time 
  127. # information.
  128. # 
  129. # March 2 1904 at 5 am, 6 minutes and 7 seconds is 5288767
  130. # April 3 1905 at 6 am, 7 minutes and 8 seconds is 39593228
  131. proc ISOTime::parseLocalizedTime {} {
  132.     global ISOTime::regdate ISOTime::matchdate alpha::platform
  133.     
  134.     if {${alpha::platform} != "alpha"} {
  135.     set known [ISOTime::__mtime -2043251572 short 1]
  136.     } else {
  137.     set known [ISOTime::__mtime 39593228]
  138.     }
  139.     
  140.     regexp -indices {(.*[^0-9])*(0?3)[^0-9]*.*} $known z pr day  
  141.     regexp -indices {(.*[^0-9])*(0?4)[^0-9]*.*} $known z pr month  
  142.     # '20' is temporary fix for buggy dev version of Alpha
  143.     regexp -indices {(.*[^0-9])*((19|20)?0?5)[^0-9]*.*} $known z pr year  
  144.     regexp -indices {(.*[^0-9])*(0?6)[^0-9]*.*} $known z pr hour  
  145.     regexp -indices {(.*[^0-9])*(0?7)[^0-9]*.*} $known z pr minutes  
  146.     regexp -indices {(.*[^0-9])*(0?8)[^0-9]*.*} $known z pr seconds
  147.     
  148.     set order ""
  149.     lappend order "[format "%.2d" [lindex $day 0]] [format "%.2d" [lindex $day 1]] day"
  150.     lappend order "[format "%.2d" [lindex $month 0]] [format "%.2d" [lindex $month 1]] month"
  151.     lappend order "[format "%.2d" [lindex $year 0]] [format "%.2d" [lindex $year 1]] year"
  152.     lappend order "[format "%.2d" [lindex $hour 0]] [format "%.2d" [lindex $hour 1]] hour"
  153.     lappend order "[format "%.2d" [lindex $minutes 0]] [format "%.2d" [lindex $minutes 1]] minutes"
  154.     lappend order "[format "%.2d" [lindex $seconds 0]] [format "%.2d" [lindex $seconds 1]] seconds"
  155.     set order [lsort $order]
  156.     set ISOTime::regdate ""
  157.     set ISOTime::matchdate ""
  158.     if {[lindex [lindex $order 0] 0] == 0} {
  159.     append ISOTime::regdate {([0-9]*)}
  160.     } else {
  161.     append ISOTime::regdate [string range $known 0 0]
  162.     }
  163.     append ISOTime::matchdate "set date([lindex [lindex $order 0] 2]) \\1;"
  164.     set tmp [ISOTime::int [lindex [lindex $order 0] 1] 1]
  165.     append ISOTime::regdate "\\[string range $known $tmp $tmp]"
  166.     
  167.     append ISOTime::regdate {([0-9]*)}
  168.     append ISOTime::matchdate "set date([lindex [lindex $order 1] 2]) \\2;"
  169.     set tmp [ISOTime::int [lindex [lindex $order 1] 1] 1]
  170.     append ISOTime::regdate "\\[string range $known $tmp $tmp]"
  171.     
  172.     append ISOTime::regdate {([0-9]*)}
  173.     append ISOTime::matchdate "set date([lindex [lindex $order 2] 2]) \\3;"
  174.     set tmp [ISOTime::int [lindex [lindex $order 2] 1] 1]
  175.     append ISOTime::regdate "\\[string range $known $tmp $tmp]"
  176.     
  177.     append ISOTime::regdate {\{?([0-9]*)}
  178.     append ISOTime::matchdate "set date([lindex [lindex $order 3] 2]) \\4;"
  179.     set tmp [ISOTime::int [lindex [lindex $order 3] 1] 1]
  180.     append ISOTime::regdate "\\[string range $known $tmp $tmp]"
  181.     
  182.     append ISOTime::regdate {([0-9]*)}
  183.     append ISOTime::matchdate "set date([lindex [lindex $order 4] 2]) \\5;"
  184.     set tmp [ISOTime::int [lindex [lindex $order 4] 1] 1]
  185.     append ISOTime::regdate "\\[string range $known $tmp $tmp]"
  186.     
  187.     append ISOTime::regdate {([0-9]*)( [aApPmMUhr]+\})?}
  188.     append ISOTime::matchdate "set date([lindex [lindex $order 5] 2]) \\6;"
  189. }
  190.  
  191. # Extract time information from the MacOS ticks 'when', and put it
  192. # in the 'datevar' variable. This information is independent of the
  193. # time display format of your localized version of MacOS.
  194. # 
  195. # Using 'regsub', I apply a regular expression to the localized 
  196. # representation of 'when', and this builds the command that sets
  197. # the items of the 'datevar' array. I evaluate this command, and 
  198. # 'datevar' now holds time information in a localization independent 
  199. # form.
  200. # The regular expression and the transformation expression are built by the
  201. # ISOTime::parseLocalizedTime proc. To save time, this proc is called only if 
  202. # the regular expressions are not defined. This assumes that you don't 
  203. # change the date format while Alpha is running.
  204. # 
  205. # The next step is to trim leading '0' so that the items of the array 
  206. # are simple numbers. 
  207. # 
  208. # A final step adds 1900 or 2000 to the year if it is lower than 100.  
  209. # I use the fact that the MacOS ticks 3029529600 represent 
  210. # January 1st 2000 at 0 hour, 0 minutes and 0 seconds.
  211. # 
  212. # brokenDate $when theDate sets 'theDate' so that:
  213. #   theDate(year)     contains the year of the 'when' MacOS ticks
  214. #   theDate(month)    contains the month of the 'when' MacOS ticks
  215. #   theDate(day)      contains the day of month of the 'when' MacOS ticks
  216. #   theDate(hour)     contains the hour of the 'when' MacOS ticks
  217. #   theDate(minutes)  contains the minutes of the 'when' MacOS ticks
  218. #   theDate(seconds)  contains the seconds of the 'when' MacOS ticks
  219. # 
  220. # January 1st 2000 at 0:00:00 is 3029529600
  221.  
  222. proc ISOTime::brokenDate {{when "now"} {datevar "theDate"}} {
  223.     global ISOTime::regdate ISOTime::matchdate
  224.     upvar $datevar date
  225.     
  226.     if {$when == "now"} {
  227.     set theTicks [now]
  228.     } else {
  229.     set theTicks $when
  230.     }
  231.     
  232.     if {(![info exists ISOTime::regdate]) || (![info exists ISOTime::matchdate])} {
  233.     ISOTime::parseLocalizedTime
  234.     }
  235.     
  236.     regsub [set ISOTime::regdate] [ISOTime::__mtime $theTicks] [set ISOTime::matchdate] dateCmd
  237.     eval $dateCmd
  238.     
  239.     set date(year) [ISOTime::int $date(year)]
  240.     set date(month) [ISOTime::int $date(month)]
  241.     set date(day) [ISOTime::int $date(day)]
  242.     set date(hour) [ISOTime::int $date(hour)]
  243.     set date(minutes) [ISOTime::int $date(minutes)]
  244.     set date(seconds) [ISOTime::int $date(seconds)]
  245.     
  246.     if {$date(year) < 100} {
  247.     if {$theTicks < 3029529600} {
  248.         set date(year) [expr $date(year) + 1900]
  249.     } else {
  250.         set date(year) [expr $date(year) + 2000]
  251.     }
  252.     }
  253.     return $theTicks
  254. }
  255.  
  256. # Work around peculiarity of Tcl that '09' is not an integer,
  257. # but a base 8 number, and that int(09) will give an error.
  258. proc ISOTime::int {what {plus 0}} {
  259.     regsub {^0+([1-9])} $what \\1 what
  260.     return [expr {int($what + $plus)}]
  261. }
  262.  
  263. # Build an ISO representation of the date corresponding to the 'when' MacOS 
  264. # ticks. Uses ISOTime::brokenDate to get a localization independent representation 
  265. # of time. The ISO date is in the form 'YYYY-MM-DD'.
  266. proc ISOTime::ISODate {{when "now"}} {
  267.     ISOTime::brokenDate $when curDate
  268.     return "[format "%.4u" $curDate(year)]-[format "%.2u" $curDate(month)]-[format "%.2u" $curDate(day)]"
  269. }
  270.  
  271. # Same with time added in the form 'THH:MM:SSZ'
  272. proc ISOTime::ISODateAndTime {{when "now"}} {
  273.     ISOTime::brokenDate $when curDate
  274.     return "[format "%.4u" $curDate(year)]-[format "%.2u" $curDate(month)]-[format "%.2u" $curDate(day)]T[format "%.2u" $curDate(hour)]:[format "%.2u" $curDate(minutes)]:[format "%.2u" $curDate(seconds)]Z"
  275. }
  276.  
  277. # Same with time added in the form ' HH:MM:SS' (not strict ISO, but more readable
  278. proc ISOTime::ISODateAndTimeRelaxed {{when "now"}} {
  279.     ISOTime::brokenDate $when curDate
  280.     return "[format "%.4u" $curDate(year)]-[format "%.2u" $curDate(month)]-[format "%.2u" $curDate(day)] [format "%.2u" $curDate(hour)]:[format "%.2u" $curDate(minutes)]:[format "%.2u" $curDate(seconds)]"
  281. }